home *** CD-ROM | disk | FTP | other *** search
/ Amiga News 95 / Amiga News 95.iso / dpat / dpat36 / memophone / mémophone (.txt) < prev    next >
AmigaBASIC Source Code  |  1992-09-02  |  7KB  |  291 lines
  1. '**************************************
  2. '*                                    *
  3. '* MEMOPHONE :Répertoire et composeur *
  4. '*                                    *
  5. '*             téléphonique           *
  6. '*                                    *
  7. '*    par Joseph Costa et j2c pour:   *
  8. '*                                    *
  9. '*              AmigaNews             *
  10. '*                                    *
  11. '**************************************
  12. 50 :
  13. CLS: CLEAR
  14. PALETTE 1, 0.9, 0.8 ,0.8
  15. PALETTE 2, 0.1,0 ,0.55
  16. COLOR 1,2
  17. mire:
  18. CLOSE #1
  19. CLS:FONCT=0
  20. GOSUB 1000:B=0
  21. PRINT:PRINT:PRINT
  22. PRINT "                            INITIALISER ANNUAIRE"
  23. PRINT:
  24. PRINT "                         CREER UNE NOUVELLE ENTREE"
  25. PRINT:
  26. PRINT "                        RENSEIGNEMENT COMPLEMENTAIRE"
  27. PRINT:           
  28. PRINT "                          COMPOSITION TEL. (MANU.)"
  29. PRINT:
  30. PRINT "                          COMPOSITION TEL. (AUTO.)"
  31. PRINT:                      
  32. PRINT "                           ANNUAIRE TELEPHONIQUE"
  33. PRINT:
  34. PRINT "                              FIN DU PROGRAMME"
  35. PRINT:PRINT:
  36. LINE (175,27)-(434,153),,B
  37.  
  38. RP:
  39. ON ERROR GOTO 3000
  40. OPEN "DONNEES.ANNUAIRE" AS #1 LEN=70
  41. FIELD #1,1 AS K$,15 AS D$,14 AS P$,5 AS Q$,20 AS r$,15 AS V$
  42. GOSUB CMO 
  43. IF(FONCT>0) AND (FONCT<8) THEN GOTO DEBUT
  44. GOTO RP 
  45.  
  46. DEBUT:
  47. ON FONCT GOSUB 100,200,300,400,500,600,700
  48. IF FONCT<7 THEN GOTO mire 
  49. END
  50. 100 :
  51. CLS:GOSUB 1000:LOCATE 7,1
  52. PRINT"       *****************************************************************"
  53. PRINT"       *                                                               *"
  54. PRINT"       *   ATTENTION : CE MENU EFFACE LE CONTENU TOTAL DE L'ANUAIRE    *"
  55. PRINT"       *                                                               *"
  56. PRINT"       *****************************************************************" 
  57. PRINT""
  58. PRINT""
  59. PRINT""
  60. INPUT "                          EN ETES-VOUS CERTAIN ";confirm$
  61. IF confirm$<>"oui" AND confirm$<>"OUI" THEN RETURN
  62. LSET K$=CHR$(255)
  63. FOR I=1 TO 100
  64. PUT #1,I
  65. NEXT I
  66. RETURN
  67.  
  68. 200 :
  69. CLS:GOSUB 1000:GOSUB 600:GOSUB nom
  70. IF ASC(K$)<>255 THEN INPUT "      Ce n° de mémoire éxiste déja. Voulez-vous l'éffaçer ";confirm$
  71. IF ASC(K$)<>255 AND UCASE$(confirm$)<>"OUI" THEN RETURN
  72. LSET K$ = CHR$(0):CLS:PRINT:PRINT,
  73. INPUT " Nom et prénom ";DESCRIPTION$
  74. LSET D$ = DESCRIPTION$:PRINT:PRINT,
  75. INPUT " Ville";VILLE$
  76. LSET V$=VILLE$:PRINT:PRINT,
  77. INPUT " Code postal";CODE$ 
  78. LSET Q$ = CODE$:PRINT:PRINT,
  79. INPUT " Adresse";adresse$
  80. LSET r$ = adresse$:PRINT:PRINT,
  81. CLS:GOSUB CADRE:GOSUB TL:
  82. LOCATE 21,15:PRINT "Entrer le numéros à mémoriser";
  83. INPUT " ";TE$
  84. LSET P$ =TE$:PRINT
  85. PUT #1,nom%
  86. RETURN
  87.  
  88. 300 :
  89. GOSUB 600
  90. GOSUB 1000
  91. GOSUB nom
  92. IF ASC(K$)=255 THEN GOSUB NUL:RETURN
  93. CLS:LINE(120,45)-(470,150),,B
  94. LOCATE 9,22
  95. PRINT" NOM             ";D$:PRINT 
  96. PRINT TAB(22); " N° tél.         ";P$: PRINT 
  97. PRINT TAB(22);" Adresse         ";r$:PRINT 
  98. PRINT TAB(22);" Code postal     ";Q$:PRINT 
  99. PRINT TAB(22);" Ville           ";V$:PRINT 
  100. PRINT :PRINT:CR=200
  101. GOSUB TI
  102. RETURN
  103.  
  104. 400 :
  105. CLS:GOSUB 1000:GOSUB CADRE:GOSUB TL:
  106. LOCATE 21,16:PRINT "Entrer le numéros à composer";
  107. INPUT " ";a$:IF LEN(a$)<2 THEN RETURN
  108. CLS:LOCATE 6,19
  109. PRINT"Le numéros demandé est : ";a$
  110. PRINT:PRINT:
  111. B=0:RS=LEN(a$) 
  112. GOSUB STR
  113. RETURN
  114.  
  115. 500 :
  116. GOSUB 600
  117. START:
  118. LOCATE 21,16
  119. INPUT "    Entrer le n° de mémoire ";I
  120. IF I<0 OR I>100 THEN RETURN :B=0:D=0:
  121. ON ERROR GOTO 3000
  122. GET #1,I 
  123. IF ASC(K$)=255 THEN GOSUB NUL:RETURN 
  124. CLS:LOCATE 6,19
  125. PRINT"Le numéros demandé est : ";P$
  126. a$=P$:PRINT:PRINT:RS=11
  127.  
  128. STR:
  129. LINE (90,20)-(500,90),,B
  130. PRINT TAB (19);"Le numéros composé est :";
  131. STE:D=0:c=0:T=RS
  132. PRINT ".";
  133.  
  134. ST:
  135. B=B+1
  136. c$=MID$(a$,B,1) 
  137. IF c$="." OR c$=")" THEN c$="11"
  138. IF c$=" " THEN c$="11"
  139. IF c$="("THEN GOSUB SUB1:GOSUB SUB12:GOSUB INTER
  140. CHOIX%=VAL(c$):D=D+1
  141. IF D=3 THEN GOTO STE
  142. CR=150
  143. IF B>T THEN GOSUB TI:RETURN
  144.  
  145. STH:
  146. IF CHOIX%=0 THEN CHOIX%=10
  147. ON CHOIX% GOSUB  SUB1, SUB2, SUB3, SUB4, SUB5, SUB6, SUB7, SUB8, SUB9, SUB10, SUB11, SUB12
  148. IF CHOIX%<11 THEN CHOIX%=12:GOTO STH
  149. GOTO ST 
  150. SUB1:
  151. SOUND 1209,2,255,0:SOUND 697,2,255,1:PRINT"1";
  152. RETURN
  153. SUB2:
  154. SOUND 1336,2,255,0:SOUND 697,2,255,1:PRINT"2";
  155. RETURN
  156. SUB3:
  157. SOUND 1477,2,255,0:SOUND 697,2,255,1:PRINT"3";
  158. RETURN
  159. SUB4:
  160. SOUND 1209,2,255,0:SOUND 770,2,255,1:PRINT"4";
  161. RETURN
  162. SUB5:
  163. SOUND 770,2,255,0:SOUND 1336,2,255,1:PRINT"5";
  164. RETURN
  165. SUB6:
  166. SOUND 770,2,255,0:SOUND 1477,2,255,1:PRINT"6";
  167. RETURN
  168. SUB7:
  169. SOUND 1209,2,255,0:SOUND 852,2,255,1:PRINT"7";
  170. RETURN
  171. SUB8:
  172. SOUND 852,2,255,0:SOUND 1336,2,255,1:PRINT"8";
  173. RETURN
  174. SUB9:
  175. SOUND 1477,2,255,0:SOUND 852,2,255,1:PRINT"9";
  176. RETURN
  177. SUB10:
  178. SOUND 941,2,255,0:SOUND 1336,2,255,1:PRINT"0";
  179. RETURN
  180. SUB11:
  181. SOUND 0,0,0,0:SOUND 0,0,0,1:PRINT ".";
  182. RETURN
  183. SUB12:
  184. SOUND 0,1,0,0:SOUND 0,1,0,1:CHOIX%=11
  185. RETURN
  186. INTER:
  187. RS=14:D=0:c$="11" 
  188. J=0:GOSUB SUB12:GOSUB SUB6
  189. NTE:
  190. W=W+1:IF W<800 THEN GOTO NTE
  191. W=0
  192. RETURN
  193.  
  194. 600 : 
  195. GOSUB CADRE:GOSUB 1000
  196. LOCATE 8,10:F=0:
  197. FOR I=1 TO 100 
  198. GET #1,I
  199. IF ASC(K$)=255 GOTO 625
  200. PRINT TAB(15);I;TAB(22);D$;TAB(46);P$;
  201. F=F+1:K=K+1
  202. IF MOUSE(0)=-1 THEN GOTO 2000
  203. IF F=10 THEN SLEEP:GOTO 2000
  204. CR=150
  205. 625 :
  206. NEXT I
  207. CR=150:GOSUB TI
  208. RETURN
  209.  
  210. 700 : 
  211. CLS:GOSUB 1000
  212. PRINT:PRINT:PRINT:PRINT:
  213. PRINT TAB(33);" à bientot"
  214. PRINT:PRINT:
  215. PRINT TAB(30);"( n'oublier pas )"
  216. PRINT:
  217. PRINT TAB(29);"programme écrit par :"
  218. PRINT:
  219. PRINT TAB(35);"JOSEPH"
  220. CR=100:GOSUB TI:CLOSE #1:CLS
  221. SYSTEM
  222. RETURN
  223.  
  224. nom:
  225. LOCATE 21,16
  226. INPUT "Veuillez entrer le n° de mémoire ",nom%
  227. IF (nom%<1) OR (nom%>100) THEN 50
  228. GET #1,nom%
  229. RETURN
  230.  
  231. NUL:
  232. CR=100 
  233. LOCATE 22,20:PRINT "   Numéros de mémoire non existant"
  234. GOSUB TI
  235. RETURN
  236.  
  237. CMO:
  238. O$=INKEY$
  239. MOUSE ON
  240. IF MOUSE(0)>-1 THEN CMO
  241. IF ABS(X-MOUSE(1)) > 1 THEN MP
  242. IF ABS(Y-MOUSE(2)) < 3 THEN CMO
  243.  
  244. MP:
  245. X=MOUSE(1): Y=MOUSE(2)
  246. IF Y>38 AND Y<46 AND X>173 AND X<410 THEN FONCT=1
  247. IF Y>55 AND Y<64 AND X>173 AND X<410 THEN FONCT=2
  248. IF Y>71 AND Y<79 AND X>173 AND X<410 THEN FONCT=3
  249. IF Y>86 AND Y<94 AND X>173 AND X<410 THEN FONCT=4
  250. IF Y>102 AND Y<110 AND X>173 AND X<410 THEN FONCT=5
  251. IF Y>119 AND Y<126 AND X>173 AND X<410 THEN FONCT=6
  252. IF Y>135 AND Y<143 AND X>173 AND X<410 THEN FONCT=7
  253. MOUSE OFF
  254. RETURN
  255.  
  256. 1000 :
  257. LOCATE 1,69 :PRINT TIME$:PRINT TAB(68)DATE$
  258. RETURN
  259.  
  260. 2000 :SLEEP:F=0:
  261. IF MOUSE(0) =-1 THEN GOTO TI:
  262. GOSUB CADRE
  263. GOTO 625
  264. CADRE:
  265. CLS:K=0:PRINT :PRINT :PRINT:PRINT : 
  266. PRINT TAB(15);"N°mem";TAB(23);"NOM ET PRENOM";TAB(45);"N° TELEPHONE":PRINT :
  267. LINE (110,30)-(310,150),,B
  268. LINE (310,30)-(490,150),,B
  269. LINE (110,40)-(490,40)
  270. LINE (155,30)-(155,150)
  271. RETURN
  272.  
  273. TI:IF MOUSE(0) =-1 THEN RETURN
  274. LOCATE 21,16:PRINT "                 Attente !!!          "
  275. J=J+1:IF J<CR THEN GOTO TI:
  276. J=0:CR=0:RETURN 
  277.  
  278. TL:
  279. LOCATE 5,15 
  280. PRINT "        [ Exemple ]   " 
  281. LOCATE 9,21:PRINT "Province --> Paris    (1)12.34.56.78 "
  282. LOCATE 11,21:PRINT "  Paris  --> Prov.    ().12.34.56.78 "
  283. LOCATE 13,21:PRINT "  Paris  --> Paris       12.34.56.78 "
  284. LOCATE 15,21:PRINT "  Prov.  --> Prov.       12.34.56.78 "
  285. LINE (310,30)-(310,150)
  286. RETURN
  287. 3000 :
  288. IF (ERR=63) AND (ERL=90) THEN CLOSE #1
  289. RESUME mire:
  290.  
  291.